home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / getopt < prev    next >
Text File  |  1993-09-11  |  1KB  |  50 lines
  1.  
  2. (define getopt:scan #f)
  3. (define getopt:char #\-)
  4. (define getopt:opt #f)
  5. (define *optind* 1)
  6. (define *optarg* 0)
  7.  
  8. (define (getopt argc argv optstring)
  9.   (let ((opts (string->list optstring))
  10.     (place #f)
  11.     (arg #f)
  12.     (argref (lambda () ((if (vector? argv) vector-ref list-ref)
  13.                 argv *optind*))))
  14.     (and
  15.      (cond ((and getopt:scan (not (string=? "" getopt:scan))) #t)
  16.        ((>= *optind* argc) #f)
  17.        (else
  18.         (set! arg (argref))
  19.         (cond ((or (<= (string-length arg) 1)
  20.                (not (char=? (string-ref arg 0) getopt:char)))
  21.            #f)
  22.           ((and (= (string-length arg) 2)
  23.             (char=? (string-ref arg 1) getopt:char))
  24.            (set! *optind* (+ *optind* 1))
  25.            #f)
  26.           (else
  27.            (set! getopt:scan
  28.              (substring arg 1 (string-length arg)))
  29.            #t))))
  30.      (begin
  31.        (set! getopt:opt (string-ref getopt:scan 0))
  32.        (set! getopt:scan
  33.          (substring getopt:scan 1 (string-length getopt:scan)))
  34.        (if (string=? "" getopt:scan) (set! *optind* (+ *optind* 1)))
  35.        (set! place (member getopt:opt opts))
  36.        (cond ((not place) #\?)
  37.          ((or (null? (cdr place)) (not (char=? #\: (cadr place))))
  38.           getopt:opt)
  39.          ((not (string=? "" getopt:scan))
  40.           (set! *optarg* getopt:scan)
  41.           (set! *optind* (+ *optind* 1))
  42.           (set! getopt:scan #f)
  43.           getopt:opt)
  44.          ((< *optind* argc)
  45.           (set! *optarg* (argref))
  46.           (set! *optind* (+ *optind* 1))
  47.           getopt:opt)
  48.          ((and (not (null? opts)) (char=? #\: (car opts))) #\:)
  49.          (else #\?))))))
  50.